keyPaths :: Key -> NE.NonEmpty OsPath
keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes
-uuidPath :: UUID -> OsPath
-uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)
-
import Annex.LockPool
import qualified Data.Map as M
-import qualified System.FilePath.ByteString as P
{- Create a specified lock file, and takes a shared lock, which is retained
- in the cache. -}
-lockFileCached :: RawFilePath -> Annex ()
+lockFileCached :: OsPath -> Annex ()
lockFileCached file = go =<< fromLockCache file
where
go (Just _) = noop -- already locked
#endif
changeLockCache $ M.insert file lockhandle
-unlockFile :: RawFilePath -> Annex ()
+unlockFile :: OsPath -> Annex ()
unlockFile file = maybe noop go =<< fromLockCache file
where
go lockhandle = do
getLockCache :: Annex LockCache
getLockCache = getState lockcache
-fromLockCache :: RawFilePath -> Annex (Maybe LockHandle)
+fromLockCache :: OsPath -> Annex (Maybe LockHandle)
fromLockCache file = M.lookup file <$> getLockCache
changeLockCache :: (LockCache -> LockCache) -> Annex ()
{- Runs an action with a shared lock held. If an exclusive lock is held,
- blocks until it becomes free. -}
-withSharedLock :: RawFilePath -> Annex a -> Annex a
+withSharedLock :: OsPath -> Annex a -> Annex a
withSharedLock lockfile a = debugLocks $ do
- createAnnexDirectory $ P.takeDirectory lockfile
+ createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracket (lock mode lockfile) (liftIO . dropLock) (const a)
where
{- Runs an action with an exclusive lock held. If the lock is already
- held, blocks until it becomes free. -}
-withExclusiveLock :: RawFilePath -> Annex a -> Annex a
+withExclusiveLock :: OsPath -> Annex a -> Annex a
withExclusiveLock lockfile a = bracket
(takeExclusiveLock lockfile)
(liftIO . dropLock)
(const a)
{- Takes an exclusive lock, blocking until it's free. -}
-takeExclusiveLock :: RawFilePath -> Annex LockHandle
+takeExclusiveLock :: OsPath -> Annex LockHandle
takeExclusiveLock lockfile = debugLocks $ do
- createAnnexDirectory $ P.takeDirectory lockfile
+ createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
lock mode lockfile
where
{- Tries to take an exclusive lock and run an action. If the lock is
- already held, returns Nothing. -}
-tryExclusiveLock :: RawFilePath -> Annex a -> Annex (Maybe a)
+tryExclusiveLock :: OsPath -> Annex a -> Annex (Maybe a)
tryExclusiveLock lockfile a = debugLocks $ do
- createAnnexDirectory $ P.takeDirectory lockfile
+ createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracket (lock mode lockfile) (liftIO . unlock) go
where
- Does not create the lock directory or lock file if it does not exist,
- taking an exclusive lock will create them.
-}
-trySharedLock :: RawFilePath -> Annex (Maybe LockHandle)
+trySharedLock :: OsPath -> Annex (Maybe LockHandle)
trySharedLock lockfile = debugLocks $
#ifndef mingw32_HOST_OS
tryLockShared Nothing lockfile
import qualified System.FilePath.ByteString as P
{- replaceFile on a file located inside the gitAnnexDir. -}
-replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
+replaceGitAnnexDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceGitAnnexDirFile = replaceFile createAnnexDirectory
{- replaceFile on a file located inside the .git directory. -}
-replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
+replaceGitDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceGitDirFile = replaceFile $ \dir -> do
top <- fromRepo localGitDir
liftIO $ createDirectoryUnder [top] dir
{- replaceFile on a worktree file. -}
-replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
+replaceWorkTreeFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceWorkTreeFile = replaceFile createWorkTreeDirectory
{- Replaces a possibly already existing file with a new version,
- The createdirectory action is only run when moving the file into place
- fails, and can create any parent directory structure needed.
-}
-replaceFile :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a
+replaceFile :: (OsPath -> Annex ()) -> OsPath -> (OsPath -> Annex a) -> Annex a
replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action
-replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
+replaceFile' :: (OsPath -> Annex ()) -> OsPath -> (a -> Bool) -> (OsPath -> Annex a) -> Annex a
replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
- let basetmp = relatedTemplate' (P.takeFileName file)
- withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do
- let tmpfile = toRawFilePath tmpdir P.</> basetmp
+ let basetmp = relatedTemplate (fromOsPath (takeFileName file))
+ withTmpDirIn othertmpdir basetmp $ \tmpdir -> do
+ let tmpfile = tmpdir </> basetmp
r <- action tmpfile
when (checkres r) $
replaceFileFrom tmpfile file createdirectory
return r
-replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()
+replaceFileFrom :: OsPath -> OsPath -> (OsPath -> Annex ()) -> Annex ()
replaceFileFrom src dest createdirectory = go `catchIO` fallback
where
go = liftIO $ moveFile src dest
-- directory that is passed to it. However, once the action is done,
-- any files left in that directory may be cleaned up by another process at
-- any time.
-withOtherTmp :: (RawFilePath -> Annex a) -> Annex a
+withOtherTmp :: (OsPath -> Annex a) -> Annex a
withOtherTmp a = do
Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp
tmpdir <- fromRepo gitAnnexTmpOtherDir
-- Unlike withOtherTmp, this does not rely on locking working.
-- Its main use is in situations where the state of lockfile is not
-- determined yet, eg during initialization.
-withEventuallyCleanedOtherTmp :: (RawFilePath -> Annex a) -> Annex a
+withEventuallyCleanedOtherTmp :: (OsPath -> Annex a) -> Annex a
withEventuallyCleanedOtherTmp = bracket setup cleanup
where
setup = do
tmpdir <- fromRepo gitAnnexTmpOtherDirOld
void $ createAnnexDirectory tmpdir
return tmpdir
- cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath
+ cleanup = liftIO . void . tryIO . removeDirectory
-- | Cleans up any tmp files that were left by a previous
-- git-annex process that got interrupted or failed to clean up after
cleanupOtherTmp = do
tmplck <- fromRepo gitAnnexTmpOtherLock
void $ tryIO $ tryExclusiveLock tmplck $ do
- tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir
+ tmpdir <- fromRepo gitAnnexTmpOtherDir
void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir
oldtmp <- fromRepo gitAnnexTmpOtherDirOld
- liftIO $ mapM_ cleanold
+ liftIO $ mapM_ (cleanold . fromOsPath)
=<< emptyWhenDoesNotExist (dirContentsRecursive oldtmp)
-- remove when empty
- liftIO $ void $ tryIO $
- removeDirectory (fromRawFilePath oldtmp)
+ liftIO $ void $ tryIO $ removeDirectory oldtmp
where
cleanold f = do
now <- liftIO getPOSIXTime
openDb :: Annex ContentIdentifierHandle
openDb = do
dbdir <- calcRepo' gitAnnexContentIdentifierDbDir
- let db = dbdir P.</> "db"
- isnew <- liftIO $ not <$> R.doesPathExist db
+ let db = dbdir </> literalOsPath "db"
+ isnew <- liftIO $ not <$> doesDirectoryPathExist db
if isnew
then initDb db $ void $
runMigrationSilent migrateContentIdentifier
import Utility.Exception
import Annex.Common
import Annex.LockFile
-import qualified Utility.RawFilePath as R
import Database.Persist.Sql hiding (Key)
import Database.Persist.TH
import Data.Time.Clock
-import qualified System.FilePath.ByteString as P
data FsckHandle = FsckHandle H.DbQueue UUID
go = do
removedb =<< calcRepo' (gitAnnexFsckDbDir u)
removedb =<< calcRepo' (gitAnnexFsckDbDirOld u)
- removedb = liftIO . void . tryIO . removeDirectoryRecursive . fromRawFilePath
+ removedb = liftIO . void . tryIO . removeDirectoryRecursive
{- Opens the database, creating it if it doesn't exist yet. -}
openDb :: UUID -> Annex FsckHandle
openDb u = do
dbdir <- calcRepo' (gitAnnexFsckDbDir u)
- let db = dbdir P.</> "db"
- unlessM (liftIO $ R.doesPathExist db) $ do
+ let db = dbdir </> literalOsPath "db"
+ unlessM (liftIO $ doesDirectoryExist db) $ do
initDb db $ void $
runMigrationSilent migrateFsck
lockFileCached =<< calcRepo' (gitAnnexFsckDbLock u)
import Database.Types
import Annex.LockFile
import Git.Types
-import qualified Utility.RawFilePath as R
import Database.Persist.Sql hiding (Key)
import Database.Persist.TH
-import qualified System.FilePath.ByteString as P
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Control.Exception
openDb :: Annex RepoSizeHandle
openDb = lockDbWhile permerr $ do
dbdir <- calcRepo' gitAnnexRepoSizeDbDir
- let db = dbdir P.</> "db"
- unlessM (liftIO $ R.doesPathExist db) $ do
+ let db = dbdir </> literalOsPath "db"
+ unlessM (liftIO $ doesDirectoryExist db) $ do
initDb db $ void $
runMigrationSilent migrateRepoSizes
h <- liftIO $ H.openDb db "repo_sizes"
f <- relPathDirToFile tmpdir objfile
let dest = objectsDir r </> f
createDirectoryIfMissing True (parentDir dest)
- moveFile (fromOsPath objfile) (fromOsPath dest)
+ moveFile objfile dest
forM_ packs $ \packfile -> do
removeWhenExistsWith R.removeLink (fromOsPath packfile)
removeWhenExistsWith R.removeLink (fromOsPath (packIdxFile packfile))
-- | Writes content to a file, replacing the file atomically, and
-- making the new file have whatever permissions the git repository is
-- configured to use. Creates the parent directory when necessary.
-writeLogFile :: RawFilePath -> String -> Annex ()
-writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c
+writeLogFile :: OsPath -> String -> Annex ()
+writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
where
writelog tmp c' = do
- liftIO $ writeFile (fromRawFilePath (fromOsPath tmp)) c'
- setAnnexFilePerm (fromOsPath tmp)
+ liftIO $ writeFile (fromOsPath tmp) c'
+ setAnnexFilePerm tmp
-- | Runs the action with a handle connected to a temp file.
-- The temp file replaces the log file once the action succeeds.
-withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a
+withLogHandle :: OsPath -> (Handle -> Annex a) -> Annex a
withLogHandle f a = do
createAnnexDirectory (parentDir f)
replaceGitAnnexDirFile f $ \tmp ->
where
setup tmp = do
setAnnexFilePerm tmp
- liftIO $ F.openFile (toOsPath tmp) WriteMode
+ liftIO $ F.openFile tmp WriteMode
cleanup h = liftIO $ hClose h
-- | Appends a line to a log file, first locking it to prevent
-- concurrent writers.
-appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex ()
+appendLogFile :: OsPath -> OsPath -> L.ByteString -> Annex ()
appendLogFile f lck c =
createDirWhenNeeded f $
withExclusiveLock lck $ do
- liftIO $ F.withFile (toOsPath f) AppendMode $
+ liftIO $ F.withFile f AppendMode $
\h -> L8.hPutStrLn h c
setAnnexFilePerm f
--
-- The file is locked to prevent concurrent writers, and it is written
-- atomically.
-modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile :: OsPath -> OsPath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
modifyLogFile f lck modf = withExclusiveLock lck $ do
ls <- liftIO $ fromMaybe []
- <$> tryWhenExists (fileLines <$> F.readFile f')
+ <$> tryWhenExists (fileLines <$> F.readFile f)
let ls' = modf ls
when (ls' /= ls) $
createDirWhenNeeded f $
- viaTmp writelog f' (L8.unlines ls')
+ viaTmp writelog f (L8.unlines ls')
where
- f' = toOsPath f
writelog lf b = do
liftIO $ F.writeFile lf b
- setAnnexFilePerm (fromOsPath lf)
+ setAnnexFilePerm lf
-- | Checks the content of a log file to see if any line matches.
-checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool
+checkLogFile :: OsPath -> OsPath -> (L.ByteString -> Bool) -> Annex Bool
checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go
where
- setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
+ setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = return False
return r
-- | Folds a function over lines of a log file to calculate a value.
-calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t
+calcLogFile :: OsPath -> OsPath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFile f lck start update =
withSharedLock lck $ calcLogFileUnsafe f start update
-- | Unsafe version that does not do locking.
-calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t
+calcLogFileUnsafe :: OsPath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFileUnsafe f start update = bracket setup cleanup go
where
- setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
+ setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = return start
--
-- Locking is used to prevent writes to to the log file while this
-- is running.
-streamLogFile :: RawFilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
+streamLogFile :: OsPath -> OsPath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFile f lck finalizer processor =
withExclusiveLock lck $ do
streamLogFileUnsafe f finalizer processor
- liftIO $ F.writeFile' (toOsPath f) mempty
+ liftIO $ F.writeFile' f mempty
setAnnexFilePerm f
-- Unsafe version that does not do locking, and does not empty the file
-- at the end.
-streamLogFileUnsafe :: RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
+streamLogFileUnsafe :: OsPath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go
where
- setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
+ setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = finalizer
liftIO $ hClose h
finalizer
-createDirWhenNeeded :: RawFilePath -> Annex () -> Annex ()
+createDirWhenNeeded :: OsPath -> Annex () -> Annex ()
createDirWhenNeeded f a = a `catchNonAsync` \_e -> do
-- Most of the time, the directory will exist, so this is only
-- done if writing the file fails.
where
oldts _old@(_, ts) _new@(int, _) = (int, ts)
-updateUnusedLog :: RawFilePath -> UnusedMap -> Annex ()
+updateUnusedLog :: OsPath -> UnusedMap -> Annex ()
updateUnusedLog prefix m = do
oldl <- readUnusedLog prefix
newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime
writeUnusedLog prefix newl
-writeUnusedLog :: RawFilePath -> UnusedLog -> Annex ()
+writeUnusedLog :: OsPath -> UnusedLog -> Annex ()
writeUnusedLog prefix l = do
logfile <- fromRepo $ gitAnnexUnusedLog prefix
writeLogFile logfile $ unlines $ map format $ M.toList l
format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t
format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k
-readUnusedLog :: RawFilePath -> Annex UnusedLog
+readUnusedLog :: OsPath -> Annex UnusedLog
readUnusedLog prefix = do
f <- fromRepo (gitAnnexUnusedLog prefix)
- ifM (liftIO $ doesFileExist (fromRawFilePath f))
+ ifM (liftIO $ doesFileExist f)
( M.fromList . mapMaybe (parse . decodeBS) . fileLines'
- <$> liftIO (F.readFile' (toOsPath f))
+ <$> liftIO (F.readFile' f)
, return M.empty
)
where
skey = reverse rskey
ts = reverse rts
-readUnusedMap :: RawFilePath -> Annex UnusedMap
+readUnusedMap :: OsPath -> Annex UnusedMap
readUnusedMap = log2map <$$> readUnusedLog
-dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime)
+dateUnusedLog :: OsPath -> Annex (Maybe UTCTime)
dateUnusedLog prefix = do
f <- fromRepo $ gitAnnexUnusedLog prefix
- liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f
+ liftIO $ catchMaybeIO $ getModificationTime f
{- Set of unused keys. This is cached for speed. -}
unusedKeys :: Annex (S.Set Key)
=<< Annex.getState Annex.unusedkeys
unusedKeys' :: Annex [Key]
-unusedKeys' = M.keys <$> readUnusedLog ""
+unusedKeys' = M.keys <$> readUnusedLog (literalOsPath "")
setUnusedKeys :: [Key] -> Annex (S.Set Key)
setUnusedKeys ks = do
readUpgradeLog :: Annex [(RepoVersion, POSIXTime)]
readUpgradeLog = do
logfile <- fromRepo gitAnnexUpgradeLog
- ifM (liftIO $ doesFileExist (fromRawFilePath logfile))
+ ifM (liftIO $ doesFileExist logfile)
( mapMaybe (parse . decodeBS) . fileLines'
- <$> liftIO (F.readFile' (toOsPath logfile))
+ <$> liftIO (F.readFile' logfile)
, return []
)
where
recentViews :: Annex [View]
recentViews = do
- f <- fromRawFilePath <$> fromRepo gitAnnexViewLog
+ f <- fromOsPath <$> fromRepo gitAnnexViewLog
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
{- Gets the currently checked out view, if there is one.
module Remote.Helper.Hooks (addHooks) where
import qualified Data.Map as M
-import qualified System.FilePath.ByteString as P
import Annex.Common
import Types.Remote
runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a
runHooks r starthook stophook a = do
dir <- fromRepo gitAnnexRemotesDir
- let lck = dir P.</> remoteid <> ".lck"
+ let lck = dir </> remoteid <> literalOsPath ".lck"
whenM (notElem lck . M.keys <$> getLockCache) $ do
createAnnexDirectory dir
firstrun lck
a
where
- remoteid = fromUUID (uuid r)
+ remoteid = uuidPath (uuid r)
run Nothing = noop
run (Just command) = void $ liftIO $
boolSystem "sh" [Param "-c", Param command]
import Utility.LockPool (LockHandle)
import qualified Data.Map as M
-import System.FilePath.ByteString (RawFilePath)
+import Utility.OsPath
-type LockCache = M.Map RawFilePath LockHandle
+type LockCache = M.Map OsPath LockHandle
import Utility.FileSystemEncoding
import Utility.QuickCheck
import Utility.Aeson
+import Utility.OsPath
import qualified Utility.SimpleProtocol as Proto
-- A UUID is either an arbitrary opaque string, or UUID info may be missing.
isUUID :: String -> Bool
isUUID = isJust . U.fromString
+uuidPath :: UUID -> OsPath
+uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)
+
-- A description of a UUID.
newtype UUIDDesc = UUIDDesc B.ByteString
deriving (Eq, Sem.Semigroup, Monoid, IsString)
import Utility.Tmp
import Utility.Exception
import Utility.Monad
-import Utility.FileSystemEncoding
import Utility.OsPath
import qualified Utility.RawFilePath as R
import Author
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
-moveFile :: RawFilePath -> RawFilePath -> IO ()
-moveFile src dest = tryIO (R.rename src dest) >>= onrename
+moveFile :: OsPath -> OsPath -> IO ()
+moveFile src dest = tryIO (renamePath src dest) >>= onrename
where
onrename (Right _) = noop
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
- | otherwise = viaTmp mv (toOsPath dest) ()
+ | otherwise = viaTmp mv dest ()
where
rethrow = throwM e
whenM (isdir dest) rethrow
ok <- copyright =<< boolSystem "mv"
[ Param "-f"
- , Param (fromRawFilePath src)
- , Param (fromRawFilePath (fromOsPath tmp))
+ , Param (fromOsPath src)
+ , Param (fromOsPath tmp)
]
let e' = e
#else
#ifndef mingw32_HOST_OS
isdir f = do
- r <- tryIO $ R.getSymbolicLinkStatus f
+ r <- tryIO $ R.getSymbolicLinkStatus (fromOsPath f)
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s
P.setFileMode p' m
{- Using renamePath rather than the rename provided in unix-compat
- - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}
+ - because of this bug https://github.com/jacobstanley/unix-compat/issues/56 -}
rename :: RawFilePath -> RawFilePath -> IO ()
rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)
projects / git-annex.git / commitdiff